home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / PicModifierDemo.AMOS / PicModifierDemo.amosSourceCode
Encoding:
AMOS Source Code  |  1992-11-14  |  15.4 KB  |  584 lines
  1. On Error Goto ERR
  2. Screen Open 2,640,168,2,$8000
  3. Curs Off : Palette 0,$FFF
  4. Screen Display 2,128,32,,
  5. Centre "Picture Modifier Demo!" : Print : Print 
  6. Print " 1) Bild laden       16) H-Shear   31) H-Slime"
  7. Print " 2) Helligkeit       17) V-Shear   32) V-Slime"
  8. Print " 3) Schwarzwei�bild  18) H-Kippen   O) Original zeigen"
  9. Print " 4) Bild umf�rben    19) V-Kippen   R) Original restaurieren"
  10. Print " 5) Negativ          20) H-Biegen   S) Produkt zeigen"
  11. Print " 6) Farben sortieren 21) V-Biegen   C) Produkt l�schen"
  12. Print " 7) Quickraster      22) H-Zitrone  F) Prod. Farben auf Orig."
  13. Print " 8) Raster           23) V-Zitrone  D) Orig. Farben auf Prod."
  14. Print " 9) Slowraster       24) H-Rutsche  A) Autoswap"
  15. Print "10) Verwischen       25) V-Rutsche  Y) Super colorcycle!"
  16. Print "11) Verkleinern      26) H-Kugel"
  17. Print "12) Vergr��ern       27) V-Kugel"
  18. Print "13) Puzzle           28) H-Push"
  19. Print "14) H-Flip           29) V-Push"
  20. Print "15) V-Flip           30) Shift"
  21. Dim CV(63),CD(63)
  22. Global WX,WY,AX,AY,CO,CV(),CD()
  23. Degree 
  24. F$="Renoir.iff" : Gosub LODEIFF
  25. Do 
  26.   Screen To Front 2 : Screen 2
  27.   Locate 0,20 : Print "Bild: ";F$;At(20,30);"Breite:";WX;"; H�he:";WY;"; Farben:";CO;"; Helligkeit:";HEL;"   ";
  28.   Locate 0,18 : Cline : Cdown : Cline 
  29.   Locate 0,18 : Input "BEFEHL: ";I$ : I$=Upper$(I$)
  30.   If I$="1" Then F$=Fsel$("","Renoir.iff","Load an IFF","") : Gosub LODEIFF
  31.   If I$="2" Then Cup : Cline : Input "NEUE HELLIGKEIT(-15 bis 15): ";HEL : FARBE[HEL]
  32.   If I$="3"
  33.     Cup : Cline : Input "ROT (0/1),GR�N(0/1),BLAU(0,1): ";R,G,B
  34.     BLACKWHITE[HEL,R*$100+G*$10+B]
  35.   End If 
  36.   If I$="4"
  37.     Cup : Cline : Input "DUNKELSTE FARBE: ";C1
  38.     Cup : Cline : Input "HELLSTE FARBE: ";C2
  39.     SPREADCOL[HEL,C2,C1]
  40.   End If 
  41.   If I$="5" Then INVERS : FARBCOPY[1,0]
  42.   If I$="6" Then Screen To Front 1 : Screen 1 : SOR[0] : FARBCOPY[1,0] : Screen Copy 1 To 0
  43.   If I$="7" Then Cup : Cline : Input "X-ABSTAND,Y-ABSTAND: ";W,H : Screen To Front 1 : Screen 1 : QUICKRASTER[W,H]
  44.   If I$="8" Then Cup : Cline : Input "X-ABSTAND,Y-ABSTAND: ";W,H : Screen To Front 1 : Screen 1 : RASTER[W,H]
  45.   If I$="9" Then Cup : Cline : Input "X-ABSTAND,Y-ABSTAND: ";W,H : Screen To Front 1 : Screen 1 : SLOWRASTER[W,H]
  46.   If I$="10"
  47.     Cup : Cline : Input "X-ABSTAND,Y-ABSTAND,DISTANZ: ";W,H,D
  48.     Screen To Front 1 : Screen 1 : WISCHEN[W,H,D]
  49.   End If 
  50.   If I$="11" Then Cup : Cline : Input "NEUE BREITE,NEUE H�HE: ";W,H : SHRINK[W,H]
  51.   If I$="12" Then Cup : Cline : Input "UM BREITE,UM H�HE: ";W,H : STRETCH[W,H]
  52.   If I$="13"
  53.     Cup : Cline : Input "ANZAHL,X-ABSTAND,Y-ABSTAND: ";N,W,H
  54.     Screen To Front 1 : Screen 1 : PUZZLE[N,W,H]
  55.   End If 
  56.   If I$="14" Then HFLIP : Screen Copy 1 To 0
  57.   If I$="15" Then VFLIP : Screen Copy 1 To 0
  58.   If I$="16" Then Cup : Cline : Input "X-VERSCHIEBUNG,FLAG(0/1): ";W,F : HSHEAR[W,F]
  59.   If I$="17" Then Cup : Cline : Input "Y-VERSCHIEBUNG,FLAG(0/1): ";H,F : VSHEAR[H,F]
  60.   If I$="18"
  61.     Cup : Cline : Input "X-EINENGUNG,HOCH=0/RUNTER=1: ";P,F
  62.     Screen To Front 1 : Screen 1
  63.     If F=0 : HKIPPEN1[P] : Else HKIPPEN2[P] : End If 
  64.   End If 
  65.   If I$="19"
  66.     Cup : Cline : Input "Y-EINENGUNG,LINKS=0/RECHTS=1: ";P,F
  67.     Screen To Front 1 : Screen 1
  68.     If F=0 : VKIPPEN1[P] : Else VKIPPEN2[P] : End If 
  69.   End If 
  70.   If I$="20"
  71.     Cup : Cline : Input "X-EINENGUNG: ";P
  72.     Screen To Front 1 : Screen 1 : HBEND[P]
  73.   End If 
  74.   If I$="21"
  75.     Cup : Cline : Input "Y-EINENGUNG: ";P
  76.     Screen To Front 1 : Screen 1 : VBEND[P]
  77.   End If 
  78.   If I$="22"
  79.     Cup : Cline : Input "BREITE: ";P
  80.     Screen To Front 1 : Screen 1 : HZITRONE[P]
  81.   End If 
  82.   If I$="23"
  83.     Cup : Cline : Input "H�HE: ";P
  84.     Screen To Front 1 : Screen 1 : VZITRONE[P]
  85.   End If 
  86.   If I$="24"
  87.     Cup : Cline : Input "BREITE,HOCH=0/RUNTER=1: ";P,F
  88.     Screen To Front 1 : Screen 1
  89.     If F=1 : HRUTSCHE1[P] : Else HRUTSCHE2[P] : End If 
  90.   End If 
  91.   If I$="25"
  92.     Cup : Cline : Input "H�HE,LINKS=0/RECHTS=1: ";P,F
  93.     Screen To Front 1 : Screen 1
  94.     If F=1 : VRUTSCHE1[P] : Else VRUTSCHE2[P] : End If 
  95.   End If 
  96.   If I$="26"
  97.     Cup : Cline : Input "X-RADIUS,Y-RADIUS: ";W,H
  98.     Screen To Front 1 : Screen 1 : HKUGEL[W,H]
  99.   End If 
  100.   If I$="27"
  101.     Cup : Cline : Input "X-RADIUS,Y-RADIUS: ";W,H
  102.     Screen To Front 1 : Screen 1 : VKUGEL[W,H]
  103.   End If 
  104.   If I$="28"
  105.     Cup : Cline : Input "ANZAHL,BREITE,DISTANZ,HOCH=0/RUNTER=1: ";N,W,D,F
  106.     Screen To Front 1 : Screen 1
  107.     If F=1 : HPUSH1[N,W,D] : Else HPUSH2[N,W,D] : End If 
  108.   End If 
  109.   If I$="29"
  110.     Cup : Cline : Input "ANZAHL,H�HE,DISTANZ,LINKS=0/RECHTS=1: ";N,H,D,F
  111.     Screen To Front 1 : Screen 1
  112.     If F=1 : VPUSH1[N,H,D] : Else VPUSH2[N,H,D] : End If 
  113.   End If 
  114.   If I$="30"
  115.     Cup : Cline : Input "ANZAHL,BREITE,H�HE,DISTANZ: ";N,W,H,D
  116.     Screen To Front 1 : Screen 1
  117.     SHIFT[N,W,H,D]
  118.   End If 
  119.   If I$="31"
  120.     Cup : Cline : Input "ANZAHL,BREITE,DISTANZ,HOCH=0/RUNTER=1: ";N,W,D,F
  121.     Screen To Front 1 : Screen 1
  122.     If F=1 : HSLIME1[N,W,D] : Else HSLIME2[N,W,D] : End If 
  123.   End If 
  124.   If I$="32"
  125.     Cup : Cline : Input "ANZAHL,H�HE,DISTANZ,LINKS=0/RECHTS=1: ";N,H,D,F
  126.     Screen To Front 1 : Screen 1
  127.     If F=1 : VSLIME1[N,H,D] : Else VSLIME2[N,H,D] : End If 
  128.   End If 
  129.   If I$="O" Then Screen To Front 0 : Wait Key : Screen To Front 1
  130.   If I$="R" Then Screen Copy 0 To 1
  131.   If I$="S" Then Screen To Front 1 : Wait Key 
  132.   If I$="C" Then Screen 1 : Cls 
  133.   If I$="F" Then FARBCOPY[1,0]
  134.   If I$="D" Then FARBCOPY[0,1]
  135.   If I$="A" Then Repeat : Screen To Front 0 : Wait 10 : Screen To Front 1 : Wait 10 : Until Inkey$<>""
  136.   If I$="Y"
  137.     Screen To Front 1 : Screen 1
  138.     Repeat 
  139.       SPREADCOL[HEL,Rnd(4096),Rnd(4096)]
  140.       Wait 20
  141.     Until Inkey$<>""
  142.   End If 
  143. Loop 
  144. LODEIFF:
  145.   Load Iff F$,0
  146.   WX=Screen Width : WY=Screen Height : CO=Screen Colour
  147.   RES=0 : AX=1 : AY=1
  148.   If WX>639 and CO<32 Then Add RES,$8000 : AX=2
  149.   If WY>399 Then Add RES,4 : AY=2
  150.   Screen Display 0,128,50+56,,
  151.   Screen Open 1,WX,WY,CO,RES
  152.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  153.   Screen Display 1,128,50+56,,
  154.   Screen Copy 0 To 1
  155.   HEL=0 : FARBE[HEL]
  156. Return 
  157. ERR:
  158.   Resume Next 
  159. End 
  160. Procedure FARBCOPY[S,D]
  161.   A=Screen
  162.   Screen D : Get Palette S
  163.   Screen A
  164. End Proc
  165. Procedure D0UBLEKILL
  166.   For A=0 To CO-1
  167.     CV(A)=A
  168.   Next 
  169.   For B=0 To CO-1
  170.     For A=0 To CO-1
  171.       If(B<>A) and(Colour(B)=Colour(A)) and Colour(B)<>$F0F Then CV(A)=B : Colour A,$F0F
  172.     Next 
  173.   Next 
  174.   For Y=0 To WY-1
  175.     For X=0 To WX-1
  176.       P=Point(X,Y) : If CV(P)<>P Then Plot X,Y,CV(P)
  177.     Next 
  178.   Next 
  179. End Proc
  180. Procedure SOR[M]
  181.   For A=0 To CO-1
  182.     CV(A)=A
  183.   Next 
  184.   For B=0 To CO-1
  185.     For A=0 To CO-1
  186.       If M=0
  187.         If Colour(CV(A))>Colour(CV(B)) : Swap CV(A),CV(B) : End If 
  188.       Else 
  189.         CC=Colour(CV(A))
  190.         C1=(CC/$100)+((CC and $F0)/$10)+(CC and $F)
  191.         CC=Colour(CV(B))
  192.         C2=(CC/$100)+((CC and $F0)/$10)+(CC and $F)
  193.         If C1>C2 : Swap CV(A),CV(B) : End If 
  194.       End If 
  195.     Next 
  196.   Next 
  197.   RE_MAP
  198. End Proc
  199. Procedure RE_MAP
  200.   S=Screen
  201.   For A=0 To CO-1
  202.     Screen 0 : C1=Colour(CV(A))
  203.     Screen 1 : Colour A,C1
  204.   Next 
  205.   Screen S
  206.   For A=0 To CO-1
  207.     CD(CV(A))=A
  208.   Next 
  209.   For Y=0 To WY-1
  210.     For X=0 To WX-1
  211.       P=Point(X,Y) : If CD(P)<>P Then Plot X,Y,CD(P)
  212.     Next 
  213.   Next 
  214. End Proc
  215. Procedure UNUSED
  216.   For A=0 To CO-1 : CV(A)=0 : Next 
  217.   C=0
  218.   For Y=0 To WY-1 Step 2
  219.     For X=0 To WX-1 Step 2
  220.       A=Point(X,Y) : If CV(A)=0 Then CV(A)=1 : Inc C : If C=CO Then Exit 
  221.     Next 
  222.   Next 
  223.   For A=0 To CO-1
  224.     If CV(A)=0 Then Colour A,$F0F
  225.   Next 
  226. End Proc
  227. Procedure INVERS
  228.   For A=0 To Min(CO-1,31)
  229.     Screen 0 : C=Colour(A)
  230.     Screen 1 : Colour A,$FFF-C
  231.   Next 
  232. End Proc
  233. Procedure SPREADCOL[H,F1,F2]
  234.   For A=0 To Min(CO-1,31)
  235.     Screen 0 : C=Colour(A)
  236.     R=(C and $F00)/$100
  237.     G=(C and $F0)/$10
  238.     B=C and $F
  239.     C=(R+B+G+1)/3
  240.     C=Min(Max(C+H,0),15)
  241.     R1=(F1 and $F00)/$100
  242.     G1=(F1 and $F0)/$10
  243.     B1=F1 and $F
  244.     R2=(F2 and $F00)/$100
  245.     G2=(F2 and $F0)/$10
  246.     B2=F2 and $F
  247.     D=((R1*C)/15)*$100+((G1*C)/15)*$10+(B1*C)/15
  248.     C=15-C
  249.     Add D,((R2*C)/15)*$100+((G2*C)/15)*$10+(B2*C)/15
  250.     Screen 1 : Colour A,D
  251.   Next 
  252. End Proc
  253. Procedure BLACKWHITE[H,F]
  254.   For A=0 To Min(CO-1,31)
  255.     Screen 0 : C=Colour(A)
  256.     R=(C and $F00)/$100
  257.     G=(C and $F0)/$10
  258.     B=C and $F
  259.     C=(R+B+G+1)/3
  260.     C=Min(Max(C+H,0),15)
  261.     Screen 1 : Colour A,C*F
  262.   Next 
  263. End Proc
  264. Procedure FARBE[H]
  265.   For A=0 To Min(CO-1,31)
  266.     Screen 0 : C=Colour(A)
  267.     R=(C and $F00)/$100
  268.     G=(C and $F0)/$10
  269.     B=C and $F
  270.     R=Min(Max(R+H,0),15)
  271.     G=Min(Max(G+H,0),15)
  272.     B=Min(Max(B+H,0),15)
  273.     Screen 1 : Colour A,R*$100+G*$10+B
  274.   Next 
  275. End Proc
  276. Procedure QUICKRASTER[W,H]
  277.   For Y=0 To WY-1 Step H
  278.     For X=0 To WX-1 Step W
  279.       Ink Point(X,Y) : Bar X,Y To X+W-1,Y+H-1
  280.     Next 
  281.   Next 
  282. End Proc
  283. Procedure RASTER[W,H]
  284.   For Y=0 To WY-1 Step H
  285.     For X=0 To WX-1 Step W
  286.       For A=0 To CO : CV(A)=0 : Next 
  287.       For YY=0 To H-1
  288.         For XX=0 To W-1
  289.           Inc CV(Max(Point(X+XX,Y+YY),0))
  290.         Next 
  291.       Next 
  292.       C=0 : M=0
  293.       For A=0 To CO
  294.         If CV(A)>M Then C=A : M=CV(A)
  295.       Next 
  296.       Ink C : Bar X,Y To X+W-1,Y+H-1
  297.     Next 
  298.   Next 
  299. End Proc
  300. Procedure SLOWRASTER[W,H]
  301.   For Y=0 To WY-1 Step H
  302.     For X=0 To WX-1 Step W
  303.       For A=0 To CO-1 : CV(A)=0 : Next 
  304.       For YY=0 To H-1
  305.         For XX=0 To W-1
  306.           Inc CV(Max(Point(X+XX,Y+YY),0))
  307.         Next 
  308.       Next 
  309.       F=0
  310.       For A=0 To CO-1
  311.         CC=Colour(A)
  312.         RR=CC/$100 : GG=(CC and $F0)/$10 : BB=CC and $F
  313.         If F=0 Then R=RR : G=GG : B=BB
  314.         If CV(A)
  315.           If R>50000 or G>50000 or B>50000
  316.             R=R/(F+1) : G=G/(F+1) : B=B/(F+1) : F=0
  317.           End If 
  318.           R=R+CV(A)*RR
  319.           G=G+CV(A)*GG
  320.           B=B+CV(A)*BB
  321.           Add F,CV(A)
  322.         End If 
  323.       Next 
  324.       R=R/(F+1) : G=G/(F+1) : B=B/(F+1)
  325.       C=0 : M=999
  326.       For A=0 To CO-1
  327.         CC=Colour(A)
  328.         RR=CC/$100 : GG=(CC and $F0)/$10 : BB=CC and $F
  329.         MM=Abs(RR-R)+Abs(GG-G)+Abs(BB-B)
  330.         If MM<M Then C=A : M=MM
  331.       Next 
  332.       Ink C : Bar X,Y To X+W-1,Y+H-1
  333.     Next 
  334.   Next 
  335. End Proc
  336. Procedure WISCHEN[W,H,D]
  337.   For Y=0 To WY-1 Step H
  338.     For X=0 To WX-1 Step W
  339.       C=Colour(Max(Point(X,Y),0))
  340.       R=C/$100 : G=(C and $F0)/$10 : B=C and $F
  341.       C=Colour(Max(Point(X+D,Y+D),0))
  342.       R=((C/$100)+R)/2 : G=(((C and $F0)/$10)+G)/2 : B=((C and $F)+B)/2
  343.       M=999
  344.       For A=0 To CO-1
  345.         CC=Colour(A)
  346.         RR=CC/$100 : GG=(CC and $F0)/$10 : BB=CC and $F
  347.         MM=Abs(RR-R)+Abs(GG-G)+Abs(BB-B)
  348.         If MM<M Then C=A : M=MM
  349.       Next 
  350.       Plot X,Y,C
  351.     Next 
  352.   Next 
  353. End Proc
  354. Procedure SHRINK[W,H]
  355.   Zoom 0,0,0,WX,WY To 1,(WX-W)/2,(WY-H)/2,(WX+W)/2,(WY+H)/2
  356. End Proc
  357. Procedure STRETCH[W,H]
  358.   Zoom 0,W/2,H/2,WX-W/2,WY-H/2 To 1,0,0,WX,WY
  359. End Proc
  360. Procedure PUZZLE[N,W,H]
  361.   For A=1 To N
  362.     X1=Rnd(WX-W)/W*W : Y1=Rnd(WY-H)/H*H
  363.     Get Bob 1,X1,Y1 To X1+W,Y1+H
  364.     X2=Rnd(WX-W)/W*W : Y2=Rnd(WY-H)/H*H
  365.     Screen Copy 1,X2,Y2,X2+W,Y2+H To 1,X1,Y1
  366.     Paste Bob X2,Y2,1
  367.   Next 
  368.   Del Bob 1
  369. End Proc
  370. Procedure SHIFT[N,W,H,D]
  371.   For A=1 To N
  372.     X=Rnd(WX-W) : Y=Rnd(WY-H)
  373.     RX=Rnd(2)-1 : RY=Rnd(2)-1
  374.     For B=1 To D
  375.       Screen Copy 1,X,Y,X+W,Y+H To 1,X+RX,Y+RY
  376.     Next 
  377.   Next 
  378. End Proc
  379. Procedure HSLIME1[N,W,D]
  380.   For A=1 To N
  381.     X=Rnd(WX-W) : Y=Rnd(WY-D)
  382.     For B=1 To D
  383.       Screen Copy 1,X,Y,X+W,WY To 1,X,Y+B
  384.     Next 
  385.   Next 
  386. End Proc
  387. Procedure HSLIME2[N,W,D]
  388.   For A=1 To N
  389.     X=Rnd(WX-W) : Y=Rnd(WY-D)
  390.     For B=1 To D
  391.       Screen Copy 1,X,0,X+W,Y To 1,X,-B
  392.     Next 
  393.   Next 
  394. End Proc
  395. Procedure VSLIME1[N,H,D]
  396.   For A=1 To N
  397.     X=Rnd(WX-D) : Y=Rnd(WY-H)
  398.     For B=1 To D
  399.       Screen Copy 1,X,Y,WX,Y+H To 1,X+B,Y
  400.     Next 
  401.   Next 
  402. End Proc
  403. Procedure VSLIME2[N,H,D]
  404.   For A=1 To N
  405.     X=Rnd(WX-D) : Y=Rnd(WY-H)
  406.     For B=1 To D
  407.       Screen Copy 1,0,Y,X,Y+H To 1,-B,Y
  408.     Next 
  409.   Next 
  410. End Proc
  411. Procedure HPUSH1[N,W,D]
  412.   For A=1 To N
  413.     X=Rnd(WX-W)
  414.     For B=1 To D
  415.       Screen Copy 1,X,0,X+W,WY To 1,X,B
  416.     Next 
  417.   Next 
  418. End Proc
  419. Procedure HPUSH2[N,W,D]
  420.   For A=1 To N
  421.     X=Rnd(WX-W)
  422.     For B=1 To D
  423.       Screen Copy 1,X,0,X+W,WY To 1,X,-B
  424.     Next 
  425.   Next 
  426. End Proc
  427. Procedure VPUSH1[N,H,D]
  428.   For A=1 To N
  429.     Y=Rnd(WY-H)
  430.     For B=1 To D
  431.       Screen Copy 1,0,Y,WX,Y+H To 1,B,Y
  432.     Next 
  433.   Next 
  434. End Proc
  435. Procedure VPUSH2[N,H,D]
  436.   For A=1 To N
  437.     X=Rnd(WX-D) : Y=Rnd(WY-H)
  438.     For B=1 To D
  439.       Screen Copy 1,0,Y,WX,Y+H To 1,-B,Y
  440.     Next 
  441.   Next 
  442. End Proc
  443. Procedure HKUGEL[RX,RY]
  444.   MX=WX/2 : MY=WY/2
  445.   For A#=0 To WY Step 0.5
  446.     Y#=Cos((180*A#)/Min(WX,WY))*RY
  447.     X#=Sin((180*A#)/Min(WY,WX))*RX
  448.     If Int(Y#)<>YA and X#<>0 Then YA=Int(Y#) : Zoom 0,0,A#,WX-1,A#+1 To 1,MX-X#,MY-Y#,MX+X#,MY-Y#+1
  449.   Next 
  450. End Proc
  451. Procedure VKUGEL[RX,RY]
  452.   MX=WX/2 : MY=WY/2
  453.   For A#=0 To WX Step 0.5
  454.     Y#=Sin((180*A#)/Max(WX,WY))*RY
  455.     X#=Cos((180*A#)/Max(WY,WX))*RX
  456.     If Int(X#)<>XA and Y#<>0 Then XA=Int(X#) : Zoom 0,A#,0,A#+1,WY-1 To 1,MX-X#,MY-Y#,MX-X#+1,MY+Y#
  457.   Next 
  458. End Proc
  459. Procedure HZITRONE[R]
  460.   For Y=0 To WY-1
  461.     X#=Sin((180*Y)/WY)*R
  462.     If X#>WX/2 Then X#=WX/2
  463.     If X#>0 Then Zoom 0,0,Y,WX-1,Y+1 To 1,WX/2-X#,Y,WX/2+X#,Y+1
  464.   Next 
  465. End Proc
  466. Procedure VZITRONE[R]
  467.   For X=0 To WX-1
  468.     Y#=Sin((180*X)/WX)*R
  469.     If Y#>WY/2 Then Y#=WY/2
  470.     If Y#>0 Then Zoom 0,X,0,X+1,WY-1 To 1,X,WY/2-Y#,X+1,WY/2+Y#
  471.   Next 
  472. End Proc
  473. Procedure HRUTSCHE1[R]
  474.   For Y=0 To WY-1
  475.     X#=Sin((90*Y)/WY)*R
  476.     If X#>WX/2 Then X#=WX/2
  477.     If X#>0 Then Zoom 0,0,Y,WX-1,Y+1 To 1,WX/2-X#,Y,WX/2+X#,Y+1
  478.   Next 
  479. End Proc
  480. Procedure HRUTSCHE2[R]
  481.   For Y=0 To WY-1
  482.     X#=Sin((90*Y)/WY+90)*R
  483.     If X#>WX/2 Then X#=WX/2
  484.     If X#>0 Then Zoom 0,0,Y,WX-1,Y+1 To 1,WX/2-X#,Y,WX/2+X#,Y+1
  485.   Next 
  486. End Proc
  487. Procedure VRUTSCHE1[R]
  488.   For X=0 To WX-1
  489.     Y#=Sin((90*X)/WX)*R
  490.     If Y#>WY/2 Then Y#=WY/2
  491.     If Y#>0 Then Zoom 0,X,0,X+1,WY-1 To 1,X,WY/2-Y#,X+1,WY/2+Y#
  492.   Next 
  493. End Proc
  494. Procedure VRUTSCHE2[R]
  495.   For X=0 To WX-1
  496.     Y#=Sin((90*X)/WX+90)*R
  497.     If Y#>WY/2 Then Y#=WY/2
  498.     If Y#>0 Then Zoom 0,X,0,X+1,WY-1 To 1,X,WY/2-Y#,X+1,WY/2+Y#
  499.   Next 
  500. End Proc
  501. Procedure HBEND[R]
  502.   For Y=0 To WY-1
  503.     X#=Sin((180*Y)/WY)*R
  504.     If X#<WX/2 Then Zoom 0,0,Y,WX-1,Y+1 To 1,X#,Y,WX-X#,Y+1
  505.   Next 
  506. End Proc
  507. Procedure VBEND[R]
  508.   For X=0 To WX-1
  509.     Y#=Sin((180*X)/WX)*R
  510.     If Y#<WY/2 Then Zoom 0,X,0,X+1,WY-1 To 1,X,Y#,X+1,WY-Y#
  511.   Next 
  512. End Proc
  513. Procedure HKIPPEN1[P]
  514.   For Y=WY-1 To 0 Step -1
  515.     X#=((WY-Y)*P)/WY
  516.     If X#>WX/2 Then Exit 
  517.     Zoom 0,0,Y,WX-1,Y+1 To 1,X#,Y,WX-X#,Y+1
  518.   Next 
  519. End Proc
  520. Procedure HKIPPEN2[P]
  521.   For Y=0 To WY-1
  522.     X#=(Y*P)/WY
  523.     If X#>WX/2 Then Exit 
  524.     Zoom 0,0,Y,WX-1,Y+1 To 1,X#,Y,WX-X#,Y+1
  525.   Next 
  526. End Proc
  527. Procedure VKIPPEN1[P]
  528.   For X=WX-1 To 0 Step -1
  529.     Y#=((WX-X)*P)/WX
  530.     If Y#>WY/2 Then Exit 
  531.     Zoom 0,X,0,X+1,WY-1 To 1,X,Y#,X+1,WY-Y#
  532.   Next 
  533. End Proc
  534. Procedure VKIPPEN2[P]
  535.   For X=0 To WX-1
  536.     Y#=(X*P)/WX
  537.     If Y#>WY/2 Then Exit 
  538.     Zoom 0,X,0,X+1,WY-1 To 1,X,Y#,X+1,WY-Y#
  539.   Next 
  540. End Proc
  541. Procedure HFLIP
  542.   For X=0 To WX-1
  543.     Screen Copy 0,WX-X,0,WX-X+1,WY To 1,X,0
  544.   Next 
  545. End Proc
  546. Procedure VFLIP
  547.   For Y=0 To WY-1
  548.     Screen Copy 0,0,WY-Y,WX,WY-Y+1 To 1,0,Y
  549.   Next 
  550. End Proc
  551. Procedure HSHEAR[W,UD]
  552.   For Y=0 To WY-1
  553.     X=(Y*W)/WY
  554.     If UD Then X=X mod WX : Screen Copy 0,0,Y,WX,Y+1 To 1,X-WX,Y
  555.     Screen Copy 0,0,Y,WX,Y+1 To 1,X,Y
  556.   Next 
  557. End Proc
  558. Procedure VSHEAR[H,UD]
  559.   For X=0 To WX-1
  560.     Y=(X*H)/WX
  561.     If UD Then Y=Y mod WY : Screen Copy 0,X,0,X+1,WY To 1,X,Y-WY
  562.     Screen Copy 0,X,0,X+1,WY To 1,X,Y
  563.   Next 
  564. End Proc
  565. Procedure HWAVE[R,F#,UD]
  566.   A#=0
  567.   For X=0 To WX-1
  568.     Y=Sin(A#)*R
  569.     If UD Then Screen Copy 0,X,0,X+1,WY To 1,X,Y-WY
  570.     Screen Copy 0,X,0,X+1,WY To 1,X,Y
  571.     If UD Then Screen Copy 0,X,0,X+1,WY To 1,X,Y+WY
  572.     A#=A#+F#
  573.   Next 
  574. End Proc
  575. Procedure VWAVE[R,F#,UD]
  576.   A#=0
  577.   For Y=0 To WY-1
  578.     X=Sin(A#)*R
  579.     If UD Then Screen Copy 0,0,Y,WX,Y+1 To 1,X-WX,Y
  580.     Screen Copy 0,0,Y,WX,Y+1 To 1,X,Y
  581.     If UD Then Screen Copy 0,0,Y,WX,Y+1 To 1,X+WX,Y
  582.     A#=A#+F#
  583.   Next 
  584. End Proc